KAPITOLA 7
POKRAČOVÁNÍ DPLYRU A GGPLOT2
V předchozích dvou kapitolách jsme se naučili pracovat s balíčky ggplot2 a dplyr. Balíček dplyr však obsahuje kromě nám už známých příkazů i několik dalších, kterým bude věnována právě tato kapitola. Jmenovitě se jedná o příkazy trubka, respektive group_by a summarise.
S těmito třemi příkazy povýšíme naše skripty na zcela novou úroveň, jak sami brzy zjistíte. Jejich užitečnost oceníte nejen při analýze dat, ale i při tvorbě grafů. Pojďme na ně.
Úvod
KAPITOLA 7
POKRAČOVÁNÍ DPLYRU A GGPLOT2
V předchozích dvou kapitolách jsme se naučili pracovat s balíčky ggplot2 a dplyr. Balíček dplyr však obsahuje kromě nám už známých příkazů i několik dalších, kterým bude věnována právě tato kapitola. Jmenovitě se jedná o příkazy trubka, respektive group_by a summarise.
S těmito třemi příkazy povýšíme naše skripty na zcela novou úroveň, jak sami brzy zjistíte. Jejich užitečnost oceníte nejen při analýze dat, ale i při tvorbě grafů. Pojďme na ně.
Trubka
Column
Peleliu: Trubka
Naše asijské dobrodružství začínáme poněkud zvláštně znějícím operátorem trubka (v angličtině pipe), který nám pomůže naše dlouhé zápisy ve skriptech zkrátit, a přitom zlepšit jejich čitelnost. Trubka se skládá ze tří znaků %>%, jež dokážeme vyvolat pomocí klávesové zkratky Ctrl-Shift-M. Ukažme si na příkladu, co vše trubka dovede. Vítejte na ostrově Peleliu.
Naším prvním úkolem se stane vytvořit databázi Katan2, která bude obsahovat jedince mladší 26 let, kteří chodí do klubů deskových her. Z minulé kapitoly víme, že se nám pro řešení takového úkolu bude nejlépe hodit příkaz filter() z dplyru.
library(dplyr)
Katan2 <- Katan %>%
filter(
Věk <= 25,
Klub == "člen") # A tibble: 59 x 9
Partie Věk Pohlaví Vzdělání Kolej Práce Kouření Klub Děti
<dbl> <dbl> <chr> <chr> <chr> <chr> <chr> <chr> <dbl>
1 3 14 muž ZŠ ne nepracuje nekouří člen 0
2 5 15 muž ZŠ ne nepracuje nekouří člen 0
3 6 15 muž ZŠ ne nepracuje nekouří člen 0
4 6 15 muž ZŠ ne nepracuje nekouří člen 0
5 3 15 žena ZŠ ne nepracuje nekouří člen 0
6 3 15 žena ZŠ ne nepracuje nekouří člen 0
7 5 16 muž ZŠ ne nepracuje nekouří člen 0
8 3 16 žena ZŠ ne nepracuje nekouří člen 0
9 7 16 muž ZŠ ne nepracuje nekouří člen 0
10 5 16 muž ZŠ ne nepracuje nekouří člen 0
# ... with 49 more rowsZápis předchozího skriptu je dosti odlišný od té podoby, se kterou jsme se seznámili v předchozí kapitole. Podívejme se proto na jejich srovnání v následujícím přehledu.
# skript s trubkou
Katan2 <- Katan %>%
filter(
Věk <= 25,
Klub == "člen")
# skript bez trubky
Katan2 <-
filter(Katan,
Věk <= 25,
Klub == "člen")U trubky začínáme názvem databáze, se kterou chceme v příkazu filter() pracovat (pomineme-li samotný název databáze, do které výsledek vložíme, tj. Katan2). Následně přidáme symbol pro trubku a teprve až poté pokračujeme vlastním názvem funkce, v němž už název databáze neuvádíme. Jinými slovy, pomocí trubky vléváme data do příkazu filter().
Abychom si ukázali, že trubka nemusí fungovat pouze v rámci příkazů dplyr, uveďme si další příklad. V něm budeme chtít zjistit průměr proměnné Věk.
# skript s trubkou
Katan$Věk %>%
mean()
# skript bez trubky
mean(Katan$Věk)[1] 27.64Jak je vidět, trubka funguje i u tak obyčejného příkazu, jako je třeba mean(). Jen si prosím vždy dávejte pozor na to, abyste nezapomněli na závorku u samotného příkazu. Ačkoliv je zde sice prázdná, je i tak naprosto nezbytná. Závorku si můžete představit jako nádrž, do které budete data vlévat. Bez ní se vám data rozlijí a skript nahlásí error.
Vzhledem k předchozímu představení trubky kdekoho jistě napadne otázka, a k čemu je trubka vlastně užitečná? Jistě, u výše uvedených příkazů nám toho příliš mnoho nepřinesla, pokud vůbec. Až ale začneme tvořit v dalších částech této kapitoly složitější skripty, bude se nám velice hodit. Užitečnost trubky nicméně lze demonstrovat i u jednodušších příkazů, jako je třeba hned ten následující, ve kterém najednou použijeme příkazy select(), filter() a rename().
Katan2 <- Katan %>%
select(Věk, Pohlaví) %>%
filter(Věk < 18) %>%
rename("Age" = Věk, "Gender" = Pohlaví)# A tibble: 26 x 2
Age Gender
<dbl> <chr>
1 13 žena
2 13 žena
3 14 muž
4 14 muž
5 15 muž
6 15 muž
7 15 muž
8 15 žena
9 15 žena
10 15 žena
# ... with 16 more rowsPředchozí skript nejdříve vpouští databázi Katan pomocí trubky do příkazu select(), který ponechá pouze proměnné Věk a Pohlaví. Ty následně pošle do příkazu filtr(), jenž z nich vybere pouze ty řádky, u nichž je věk nižší než 18 let. V závěru ještě dojde k přejmenování proměnných Věk a Pohlaví na Age a Gender. Výsledná databáze se uloží pod názvem Katan2.
Bez trubky bychom výše uvedený příkaz napsali následovně.
# 1. verze (zkrácená)
Katan2 <- rename((filter(select(Katan, Věk, Pohlaví), Věk < 18)),
"Age" = Věk, "Gender" = Pohlaví)
# Všimněte si, že jednotlivé příkazy zapisujeme v opačném pořadí
# než u předchozího skriptu. Je to obdobné jako při běžné práci
# se závorkami, např. (3 + (1 - (1 - 2)), u níž také budeme řešit
# závorky směrem od středu ven a nikoliv opačně.
# 2. verze (nezkrácená)
Katan2 <-
select(Katan,
Věk, Pohlaví)
Katan3 <-
filter(Katan2,
Věk < 18)
Katan4 <-
rename(Katan3,
"Age" = Věk, "Gender" = Pohlaví)
# Veškeré databáze by se mohli samozřejmě pojmenovat pouze jako Katan,
# pro větší přehlednost však přidáváme k jednotlivým verzím čísla.# A tibble: 26 x 2
Age Gender
<dbl> <chr>
1 13 žena
2 13 žena
3 14 muž
4 14 muž
5 15 muž
6 15 muž
7 15 muž
8 15 žena
9 15 žena
10 15 žena
# ... with 16 more rowsPrimárním úkolem trubky je zlepšení čitelnosti kódu, jelikož jednotlivé příkazy s její pomocí můžeme zapisovat v jejich logickém pořadí. Pojďme se proto v následující části této kapitoly seznámit s dalšími příkazy dplyru, u nichž nám trubky plně odkryjí své kouzlo. Přesuňme se tudíž jako generál Čankajšek na Tchaj-wan, na němž nalezneme další lekci.
Column
Příklady
Příklad 1
S pomocí trubky vytvořte datovou tabulku s názvem Data_z_trubky, která bude obsahovat proměnné Věk, Pohlaví, Vzdělání a Kouření. Názvy těchto proměnných následně přejmenujte na jejich anglické ekvivalenty. V dalších kroku zajistěte, aby v databázi byli zařazeni pouze jedinci ve věku 18 až 26 let (včetně). Na úplný závěr seřaďte hodnoty v proměnných podle věku, pohlaví, vzdělání a kouření v tomto pořadí.
Group_by a summarise
Column
Tchaj-pej: Group_by a summarise
Máte stále v živé paměti příkazy tapply() a aggregate() z Ria de Janeira? Ukažme si nyní v Tchaj-peji, jak lze tyto funkce obejít pomocí příkazů group_by() a summrize(). Přitom si též představíme praktické využití příkazu trubka. Podívejme se na následující příklad. V něm budeme chtít vypočítat průměr, medián, směrodatnou odchylku, minimum a maximum u proměnné Věk, a to vše podle pohlaví.
Katan %>%
group_by(Pohlaví) %>%
summarise(průměr = mean(Věk),
sd = sd(Věk),
min = min(Věk),
max = max(Věk))
# Výsledek nepřiřazujeme žádné databázi, proto píšeme pouze Katan %>%.
# Pokud bychom ho chtěli uložit, stačí uvést např. Data <- Katan %>% ...,
# kde databáze Data vznikne jako data frame.# A tibble: 2 x 5
Pohlaví průměr sd min max
<chr> <dbl> <dbl> <dbl> <dbl>
1 muž 29.8 12.2 14 75
2 žena 22.3 5.93 13 44V našem příkazu nejdříve začínáme trubkou, jelikož data z databáze Katan pomyslně přitečou do příkazu group_by(). Samotný příkaz group_by() nic nepočítá. Pouze vnitřně (neviditelně) rozdělí databázi Katan na dvě tabulky, a to podle proměnné Pohlaví. Kdybychom do závorky příkazu group_by() uvedli i další proměnnou, například Klub, group_by() by nám vytvořil čtyři pomyslné tabulky (žena_člen, žena_nečlen, muž_člen a muž_nečlen).
Když už máme data připravena, využijeme znovu operátor trubka, kterým pošleme do summarise() naši upravenou a roztříděnou databázi Katan. V samotném příkazu summarise() uvedeme nejdříve libovolný název nové proměnné a za jejím rovnítkem teprve až samotnou funkci, tak jak už ji známe. Dolarový symbol nepoužíváme. Výsledkem celého skriptu se stane nová tabulka, jež bude obsahovat právě tolik proměnných, jako jich obsahují příkazy group_by() a summarise() dohromady. Počet řádků nové databáze se řídí počtem jednotlivých kombinací, kterých lze díky group_by() dosáhnout. Pokud tedy dělíme naše data pouze podle pohlaví, získáme dva řádky. Pokud je budeme dělit nejen podle pohlaví, ale například i podle proměnné Klub, získáme je čtyři (viz žena_člen, žena_nečlen, muž_člen a muž_nečlen).
Katan %>%
group_by(Pohlaví, Klub) %>%
summarise(průměr = mean(Věk),
sd = sd(Věk),
min = min(Věk),
max = max(Věk))# A tibble: 4 x 6
# Groups: Pohlaví [2]
Pohlaví Klub průměr sd min max
<chr> <chr> <dbl> <dbl> <dbl> <dbl>
1 muž člen 22.7 5.64 14 35
2 muž nečlen 33.9 13.1 14 75
3 žena člen 21.2 3.97 15 26
4 žena nečlen 23.1 7.01 13 44Ukažme si nyní složitější variantu úvodního příkladu. V něm budeme filtrovat data nejen podle pohlaví, ale též podle proměnné Práce. K tomu se u jednotlivých výpočtů průměru, směrodatné odchylky, minima a maxima zaměříme kromě proměnné Věk i na proměnnou Děti.
Katan %>%
group_by(Pohlaví, Práce) %>%
summarise(průměr_Věk = mean(Věk),
sd_Věk= sd(Věk),
min_Věk= min(Věk),
max_Věk= max(Věk),
průměr_Děti = mean(Děti),
sd_Děti = sd(Děti),
min_Děti = min(Děti),
max_Děti = max(Děti))# A tibble: 4 x 10
# Groups: Pohlaví [2]
Pohlaví Práce průměr_Věk sd_Věk min_Věk max_Věk průměr_Děti sd_Děti min_Děti
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 muž neprac~ 19.8 2.98 14 25 0 0 0
2 muž pracuje 36.5 11.4 23 75 1.52 1.06 0
3 žena neprac~ 19.1 3.09 13 25 0.0278 0.167 0
4 žena pracuje 27.5 5.83 24 44 0.0909 0.426 0
# ... with 1 more variable: max_Děti <dbl>Jak je vidět, není příliš praktické vypisovat jednotlivé statistické funkce a proměnné zvlášť pro každý výpočet. Proto se nyní podívejme na poněkud odlišný zápis pomocí funkce summarise_each(), který nám umožní najednou vypsat nejenom veškeré funkce, které budeme chtít použít (průměr, směrodatnou odchylku, minimum a maximum), ale i všechny proměnné (Věk a Děti), pro něž budeme chtít výpočty provést.
Katan %>%
group_by(Pohlaví, Práce) %>%
summarise_each(funs(mean, sd, min, max), Věk, Děti)# A tibble: 4 x 10
# Groups: Pohlaví [2]
Pohlaví Práce Věk_mean Děti_mean Věk_sd Děti_sd Věk_min Děti_min Věk_max
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 muž nepracuje 19.8 0 2.98 0 14 0 25
2 muž pracuje 36.5 1.52 11.4 1.06 23 0 75
3 žena nepracuje 19.1 0.0278 3.09 0.167 13 0 25
4 žena pracuje 27.5 0.0909 5.83 0.426 24 0 44
# ... with 1 more variable: Děti_max <dbl>Výše uvedený zápis je již mnohem stručnější a elegantnější. Problém však nastane, pokud nám v databázi budou chybět hodnoty. V takovém případě by se nám totiž ozval error. Jak jej odstranit? Pokud bychom chtěli vypočítat pouze průměr u proměnné Věk, volili bychom tento známý příkaz.
mean(Katan$Věk, na.rm = TRUE)[1] 27.64Možná by Vás proto napadlo předchozí skript přepsat do následující podoby.
Katan %>%
group_by(Pohlaví, Práce) %>%
summarise_each(funs(mean(na.rm = TRUE),
sd(na.rm = TRUE),
min(na.rm = TRUE),
max(na.rm = TRUE)),
Věk, Děti)Takovýto skript však nebude fungovat kvůli problému s trubkou. Příkazy mean(), sd(), min() a max() totiž nejsou příkazy z dplyru. Pokud tak používáme trubku, musíme tyto příkazy upravit do následující podoby.
Katan$Věk %>%
mean(., na.rm = TRUE)[1] 27.64Všimněte si prosím tečky, která nám říká, na kterou pozici mají data z trubky přitéct. V našem případě se jedná o první pozici za závorkou (viz mean(Katan$Vek, na.rm = TRUE)). Tečka není nutná pouze tehdy, kdy je závorka prázdná, jako v následujícím příkazu či jedná-li se o příkaz z dplyru (např. filter(), select() atd.) nebo dalších balíčků (ggplot2, mapy v leafletu se kterými se seznámíme v příští kapitole).
Katan$Věk %>%
mean()
# respektive
Katan %>%
filter(Věk <= 25) Na druhou stranu i s tečkou budou příkazy bez problému fungovat.
Katan$Věk %>%
mean(.)
# respektive
Katan %>%
filter(., Věk <= 25) Výsledný skript našeho původního příkladu bude proto vypadat následovně.
Katan %>%
group_by(Pohlaví, Práce) %>%
summarise_each(funs(mean(., na.rm = TRUE),
sd(., na.rm = TRUE),
min(., na.rm = TRUE),
max(., na.rm = TRUE)),
Věk, Děti)# A tibble: 4 x 10
# Groups: Pohlaví [2]
Pohlaví Práce Věk_mean Děti_mean Věk_sd Děti_sd Věk_min Děti_min Věk_max
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 muž nepracuje 19.8 0 2.98 0 14 0 25
2 muž pracuje 36.5 1.52 11.4 1.06 23 0 75
3 žena nepracuje 19.1 0.0278 3.09 0.167 13 0 25
4 žena pracuje 27.5 0.0909 5.83 0.426 24 0 44
# ... with 1 more variable: Děti_max <dbl>Ponechme na chvíli funkci summarise_each() stranou a podívejme se na další úkol. V něm nás nebudou zajímat informace získané pomocí mean(), sd(), max() či min(), jelikož se budeme zabývat prostou četností jevů. Chceme-li například zjistit, kolik máme můžu a žen v databázi, lze využít jednoduchou funkci table(Katan$Pohlaví). Co když ale budeme chtít zjistit něco složitějšího? Představte si například, že máte za cíl vyzkoumat, jaký je procentuální podíl mužů a žen podle následujících věkových skupin (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 65 let a důchodce od 65 let)?
Katan2 <- Katan %>%
mutate(VěkSkupiny = cut(Věk,
breaks = c(0, 18, 26, 65, 150),
right = FALSE,
labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
"dospělý od 26 do 65 let", "důchodce od 65 let"))) %>%
group_by(Pohlaví, VěkSkupiny) %>%
summarise(
Četnost_abs = n(),
Četnost_rel = (n()/nrow(Katan))*100)# A tibble: 7 x 4
# Groups: Pohlaví [2]
Pohlaví VěkSkupiny Četnost_abs Četnost_rel
<chr> <fct> <int> <dbl>
1 muž teenager do 18 let 16 8
2 muž dospělý od 18 do 26 let 47 23.5
3 muž dospělý od 26 do 65 let 75 37.5
4 muž důchodce od 65 let 4 2
5 žena teenager do 18 let 10 5
6 žena dospělý od 18 do 26 let 38 19
7 žena dospělý od 26 do 65 let 10 5 První část skriptu se zabývá vytvořením nové proměnné VěkSkupiny za přispění funkce cut(). Výsledná proměnná je připojena ke stávající databázi Katan díky mutate(). Ve druhé části skriptu group_by() rozdělí naši tabulku na pomyslných osm dílů podle proměnných Pohlaví a VěkSkupiny (2 pohlaví x 4 věkové skupiny = 8 variant). Takto rozdělená tabulka je pomocí trubky převedena do funkce summarise(), u které nejdříve vypočítáme absolutní četnost n() a poté i relativní četnost (n()/nrow(Katan))*100. Výslednou tabulku převedeme do nově vzniklého data frame s názvem Katan2.
Máte pochybnosti o tom, zdali příkaz n() funguje správně a chtěli byste ho konfrontovat s příkazem table()? Žádný problém. Podívejme se na následující srovnání.
# přístup dplyr
Katan2 <- Katan %>%
mutate(VěkSkupiny = cut(Věk,
breaks = c(0, 18, 26, 65, 150),
right = FALSE,
labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
"dospělý od 26 do 65 let", "důchodce od 65 let"))) %>%
group_by(Pohlaví, VěkSkupiny) %>%
summarise(
Četnost_abs = n())
# přístup table()
Katan2 <- Katan %>%
mutate(VěkSkupiny = cut(Věk,
breaks = c(0, 18, 26, 65, 150),
right = FALSE,
labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
"dospělý od 26 do 65 let", "důchodce od 65 let")))
table(Katan2$Pohlaví, Katan2$VěkSkupiny)[1] "Přístup dplyr"# A tibble: 7 x 3
# Groups: Pohlaví [2]
Pohlaví VěkSkupiny Četnost_abs
<chr> <fct> <int>
1 muž teenager do 18 let 16
2 muž dospělý od 18 do 26 let 47
3 muž dospělý od 26 do 65 let 75
4 muž důchodce od 65 let 4
5 žena teenager do 18 let 10
6 žena dospělý od 18 do 26 let 38
7 žena dospělý od 26 do 65 let 10[1] "Přístup table"
teenager do 18 let dospělý od 18 do 26 let dospělý od 26 do 65 let
muž 16 47 75
žena 10 38 10
důchodce od 65 let
muž 4
žena 0Výhodou přístupu z dplyr je zejména to, že výsledek obdržíme v přehledném formátu data frame, se kterým lze následně bez problémů pracovat.
Abychom si vyzkoušeli group_by() a summarise() ještě trochu více do hloubky, nainstalujme si nyní balíček hflights, který obsahuje data z letecké přepravy. Ten stáhneme do R tak, jako by se jednalo o obyčejný balíček, podobně jako dplyr.
install.packages("hflights")
library(hflights)
flights <- hflights
# Databázi přejmenujeme na flights, tímto krokem ji navíc dostaneme
# do pravého horního panelu.Máme-li už databázi staženou, podívejme se se na následující příklad. V něm budeme chtít zjistit počty zrušených a nezrušených letů podle letiště.
flights %>%
group_by(Dest) %>%
summarise(Cancelled = sum(Cancelled),
Not_Cancelled = n()-sum(Cancelled))
# proměnná Dest označuje kód cílového letiště
# proměnná Cancelled obsahuje nuly a jedničky (zrušený let)# A tibble: 116 x 3
Dest Cancelled Not_Cancelled
<chr> <int> <int>
1 ABQ 25 2787
2 AEX 12 712
3 AGS 0 1
4 AMA 32 1265
5 ANC 0 125
6 ASE 5 120
7 ATL 141 7745
8 AUS 27 4995
9 AVL 3 347
10 BFL 1 503
# ... with 106 more rowsVýše uvedený příklad lze vyřešit i bez summarise() a to díky table(). Všimněte si struktury následujícího skriptu. Nejdříve vybíráme proměnnou, podle které mají být data rozřazena. V našem případě se jedná o letecké destinace (proměnná Dest). V dalším kroku pomocí příkazu select() vybíráme jedinou proměnnou a to Cancelled, která zobrazuje jedničku pro zrušený let a nulu pro ten odbavený. Výsledný příkaz končí prázdnou závorkou příkazu table(), do níž přitečou data pomocí trubky.
flights %>%
group_by(Dest) %>%
select(Cancelled) %>%
table() Cancelled
Dest 0 1
ABQ 2787 25
AEX 712 12
AGS 1 0
AMA 1265 32
ANC 125 0
ASE 120 5
ATL 7745 141
AUS 4995 27
AVL 347 3
BFL 503 1
BHM 2697 39
BKG 108 2
BNA 3451 30
BOS 1724 28
BPT 3 0
BRO 1665 27
BTR 1733 29
BWI 2527 24
CAE 547 14
CID 408 2
CLE 2132 8
CLT 4671 64
CMH 1334 14
COS 1637 20
CRP 4720 93
CRW 350 7
CVG 1518 17
DAL 9378 442
DAY 446 5
DCA 2664 35
DEN 5892 28
DFW 6500 153
DSM 635 12
DTW 2568 33
ECP 727 2
EGE 108 2
ELP 3012 24
EWR 4244 70
FLL 2455 7
GJT 401 2
GPT 1586 32
GRK 40 2
GRR 672 5
GSO 624 6
GSP 1116 7
GUC 86 0
HDN 109 1
HNL 401 1
HOB 299 10
HRL 3881 102
HSV 911 12
CHS 1191 9
IAD 1958 22
ICT 1484 33
IND 1726 24
JAN 1984 27
JAX 2123 12
JFK 677 18
LAS 4067 15
LAX 6031 33
LBB 1309 24
LEX 578 6
LFT 2257 56
LGA 2681 49
LCH 352 12
LIT 1553 26
LRD 1168 20
MAF 2263 43
MCI 3133 41
MCO 3671 16
MDW 2072 22
MEM 2352 47
MFE 1116 12
MIA 2439 24
MKE 1568 20
MLU 288 4
MOB 1641 33
MSP 1986 24
MSY 6783 40
MTJ 163 1
OAK 685 5
OKC 3114 56
OMA 2025 19
ONT 950 2
ORD 5649 99
ORF 711 6
PBI 1242 11
PDX 1232 3
PHL 2340 27
PHX 5067 29
PIT 1652 12
PNS 1516 23
PSP 106 0
RDU 1727 13
RIC 893 7
RNO 243 0
RSW 941 7
SAN 2924 12
SAT 4853 40
SAV 855 8
SDF 1269 10
SEA 2611 4
SFO 2804 14
SHV 778 9
SJC 884 1
SJU 389 2
SLC 2024 9
SMF 1011 3
SNA 1651 10
STL 2479 30
TPA 3074 11
TUL 2870 54
TUS 1550 15
TYS 1202 8
VPS 870 10
XNA 1138 34A co takhle použít pouze příkaz table()? Jistě, i to je možnost. Ale uznejte sami, nevypadal ten předchozí příkaz poněkud sofistikovaněji?
table(flights$Dest, flights$Cancelled)
0 1
ABQ 2787 25
AEX 712 12
AGS 1 0
AMA 1265 32
ANC 125 0
ASE 120 5
ATL 7745 141
AUS 4995 27
AVL 347 3
BFL 503 1
BHM 2697 39
BKG 108 2
BNA 3451 30
BOS 1724 28
BPT 3 0
BRO 1665 27
BTR 1733 29
BWI 2527 24
CAE 547 14
CID 408 2
CLE 2132 8
CLT 4671 64
CMH 1334 14
COS 1637 20
CRP 4720 93
CRW 350 7
CVG 1518 17
DAL 9378 442
DAY 446 5
DCA 2664 35
DEN 5892 28
DFW 6500 153
DSM 635 12
DTW 2568 33
ECP 727 2
EGE 108 2
ELP 3012 24
EWR 4244 70
FLL 2455 7
GJT 401 2
GPT 1586 32
GRK 40 2
GRR 672 5
GSO 624 6
GSP 1116 7
GUC 86 0
HDN 109 1
HNL 401 1
HOB 299 10
HRL 3881 102
HSV 911 12
CHS 1191 9
IAD 1958 22
ICT 1484 33
IND 1726 24
JAN 1984 27
JAX 2123 12
JFK 677 18
LAS 4067 15
LAX 6031 33
LBB 1309 24
LEX 578 6
LFT 2257 56
LGA 2681 49
LCH 352 12
LIT 1553 26
LRD 1168 20
MAF 2263 43
MCI 3133 41
MCO 3671 16
MDW 2072 22
MEM 2352 47
MFE 1116 12
MIA 2439 24
MKE 1568 20
MLU 288 4
MOB 1641 33
MSP 1986 24
MSY 6783 40
MTJ 163 1
OAK 685 5
OKC 3114 56
OMA 2025 19
ONT 950 2
ORD 5649 99
ORF 711 6
PBI 1242 11
PDX 1232 3
PHL 2340 27
PHX 5067 29
PIT 1652 12
PNS 1516 23
PSP 106 0
RDU 1727 13
RIC 893 7
RNO 243 0
RSW 941 7
SAN 2924 12
SAT 4853 40
SAV 855 8
SDF 1269 10
SEA 2611 4
SFO 2804 14
SHV 778 9
SJC 884 1
SJU 389 2
SLC 2024 9
SMF 1011 3
SNA 1651 10
STL 2479 30
TPA 3074 11
TUL 2870 54
TUS 1550 15
TYS 1202 8
VPS 870 10
XNA 1138 34Zdají se vám výše uvedené tři skripty naprosto srovnatelné a zaměnitelné? Je tomu tak pouze do určité míry. Rozdíly totiž nalezneme ve výsledných datových strukturách. Podívejme se proto na následující rekapitulaci. V té výsledky předchozích skriptů uložíme do tří proměnných Data1, Data2 a Data3.
# přístup dplyr
Data1 <- flights %>%
group_by(Dest) %>%
summarise(Cancelled = sum(Cancelled),
Not_Cancelled = n()-sum(Cancelled))
# přístup kombinace dplyr a table()
Data2 <- flights %>%
group_by(Dest) %>%
select(Cancelled) %>%
table()
# přístup table()
Data3 <- table(hflights$Dest, hflights$Cancelled)[1] "tbl_df" "tbl" "data.frame"[1] "table"[1] "table"Poslední dva skripty za použití funkce table(), navzdory jejich jednoduchosti, obsahují jedno omezení. Výsledný formát dat, chceme-li jej uchovat a dále s ním pracovat, nebude uložen v datové struktuře data frame. Chceme-li s ním proto nakládat jako s běžnou datovou tabulkou, musíme jej převést na data frame pomocí příkazu as.data.frame().
# přístup kombinace dplyr a table()
Data2 <- flights %>%
group_by(Dest) %>%
select(Cancelled) %>%
table()
Data2 <- as.data.frame(Data2)
class(Data2)
# přístup table()
Data3 <- table(hflights$Dest, hflights$Cancelled)
Data3 <- as.data.frame(Data3)
class(Data3)[1] "data.frame"[1] "data.frame"To nám však nemusí stačit, jelikož formát výsledné tabulky bude při použití funkce table() stále odlišný od té podoby, které jsme dosáhli za pomoci příkazu summarise(). Zdali to bude pro vás výhoda či nevýhoda musíte posoudit již vy sami ve vaší konkrétní situaci (viz následující obrázek).
Posuňme se v závěru této lekce ještě trochu kupředu. Funkci group_by() lze použít i ve spojitosti s dalšími příkazy z balíčku dplyr. Ukažme si je na následujícím příkladu. V něm budeme chtít zjistit, ve které tři dny v roce měli jednotliví dopravci nejdelší zpoždění.
flights %>%
group_by(UniqueCarrier) %>%
select(Month, DayofMonth, DepDelay) %>%
top_n(3, DepDelay) %>%
arrange(UniqueCarrier, desc(DepDelay))
# UniqueCarrier: kód dopravce
# DepDelay: zpoždění odletu v minutách# A tibble: 45 x 4
# Groups: UniqueCarrier [15]
UniqueCarrier Month DayofMonth DepDelay
<chr> <int> <int> <int>
1 AA 12 12 970
2 AA 11 19 677
3 AA 12 22 653
4 AS 2 28 172
5 AS 7 6 138
6 AS 4 8 102
7 B6 10 29 310
8 B6 8 19 283
9 B6 3 10 278
10 CO 8 1 981
# ... with 35 more rowsV první části skriptu pouštíme pomocí trubky data z databáze flights do příkazu group_by(), který nám údaje roztřídí podle dopravců. Následující příkaz select() nám z databáze vytřídí přebytečné proměnné a zanechá nám pouze měsíc, den, zpoždění (DepDelay) a označení pro dopravce (proměnná UniqueCarrier), které zůstane automaticky vzhledem k příkazu group_by(). Následující příkaz top_n(3, DepDelay) zobrazí tři nejvyšší hodnoty podle proměnné DepDelay. Poslední příkaz arrange() zařídí, aby byla veškerá výsledná data seřazena podle dopravce (UniqueCarrier) a následně dle zpoždění (DepDelay) v sestupném pořadí.
Libí se vám zkratky místo skutečných názvů leteckých společností? Mně tedy vůbec ne. Z tohoto důvodu si stáhněte databázi Letecke_spolecnosti, která obsahuje dva sloupce: název letecké společnosti (proměnná Dopravce) a zkratku, pod kterou ji naleznete na letištních tabulích (proměnná Zkratka). Naším úkolem se stane přepsat skript tak, aby jeho výsledkem byla databáze Zpoždění, která bude zobrazovat skutečné názvy aerolinek.
Letecke_spolecnosti <- read_excel("C:/Users/.../Letecke_spolecnosti.xlsx")
Letecke_spolecnosti$UniqueCarrier <- Letecke_spolecnosti$Zkratka
# Tento příkaz tu je zde kvůli příkazu left_join(), tak abychom
# sjednotili názvy proměnných Zkratka a UniqueCarrier.
Zpoždění <- flights %>%
group_by(UniqueCarrier) %>%
select(Month, DayofMonth, DepDelay) %>%
top_n(3, DepDelay) %>%
left_join(., Letecke_spolecnosti, by = "UniqueCarrier") %>%
select(Dopravce, Month, DayofMonth, DepDelay) %>%
rename("Zkratka" = UniqueCarrier, "Měsíc" = Month,
"Den" = DayofMonth, "Zpoždění" = DepDelay) %>%
arrange(desc(Zpoždění))# A tibble: 45 x 5
# Groups: Zkratka [15]
Zkratka Dopravce Měsíc Den Zpoždění
<chr> <chr> <int> <int> <int>
1 CO Continental Airlines 8 1 981
2 AA American Airlines 12 12 970
3 MQ Envoy Air 11 8 931
4 UA United Airlines 6 21 869
5 MQ Envoy Air 6 9 814
6 MQ Envoy Air 5 20 803
7 CO Continental Airlines 1 20 780
8 CO Continental Airlines 6 22 758
9 DL Delta 10 25 730
10 AA American Airlines 11 19 677
# ... with 35 more rowsNa úplný závěr této lekce nás bude ještě zajímat celkový počet letů za každý měsíc včetně procentuální (i absolutní) změny oproti předchozímu měsíci.
flights %>%
group_by(Month) %>%
summarise(Count_Flights = n()) %>%
mutate(abs_change = Count_Flights-lag(Count_Flights)) %>%
mutate(rel_change = (Count_Flights-lag(Count_Flights))/lag(Count_Flights)*100)
# Procentuální změny (i ty absolutní) vypočítáme pomocí funkce lag(),
# která posune hodnoty v proměnné o jednu pozici při zanechání délky
# proměnné.
# Př. x <- c(1, 2, 3, 4, 5) => lag(x) => [1] NA 1 2 3 4
# Není vám zcela jasný rozdíl mezi summarise() a mutate()?
# Pokračujte do další lekce.# A tibble: 12 x 4
Month Count_Flights abs_change rel_change
<int> <int> <int> <dbl>
1 1 18910 NA NA
2 2 17128 -1782 -9.42
3 3 19470 2342 13.7
4 4 18593 -877 -4.50
5 5 19172 579 3.11
6 6 19600 428 2.23
7 7 20548 948 4.84
8 8 20176 -372 -1.81
9 9 18065 -2111 -10.5
10 10 18696 631 3.49
11 11 18021 -675 -3.61
12 12 19117 1096 6.08Výše uvedený skript začínáme obligátním průtokem dat pomocí trubky do příkazu group_by(), který nám rozdělí data do jednotlivých měsíců. Poté následuje příkaz summarise(), který si klade za cíl spočítat počty letů podle jednotlivých měsíců. Výsledkem se stanou dva sloupce proměnných, které vidíte výše (proměnné Month a Count_Flights). Tímto ale skript nekončí, jelikož pokračuje dvěma příkazy mutate(), které přidávají další dva sloupce. První z příkazů mutate() si klade za cíl vytvořit proměnnou abs_change, která bude sledovat rozdíl mezi počty odbavených letů mezi jednotlivými měsíci v absolutních číslech (např. rozdíl mezi únorem a lednem, jehož hodnota bude uvedena v řádku za únor). Druhý příkaz mutate() následně tytéž údaje převede na procenta (např. ((únor - leden) / leden) * 100).
Ačkoliv byla nynější lekce v hlavním městě Čínské republiky (tak totiž zní oficiální název Tchaj-wanu) poněkud obsáhlá, neznamená to, že s příkazy group_by() a summarise() v této kapitole končíme. Věnovat se jim totiž budeme i v následujících dvou lekcích, které nás přesunou zpět k balíčku ggplot2.
Column
Příklady
Příklad 2
Zjistěte v následujících věkových skupinách (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 35 let, dospělý od 35 do 65 let, dospělý 65 let a více) zastoupení mužů a žen a jejich průměrný počet partií na osobu. Ve skriptu využijte příkaz trubka.
Příklad 3
Zjistěte průměr, medián a směrodatnou odchylku u proměnných Partie a Věk. Hodnoty určete pro skupiny rozřazené dle proměnných Vzdělání a Pohlaví (tj. ZŠ - muž, ZŠ - žena, SŠ - muž, SŠ - žena atd.). Ve skriptu využijte příkaz trubka.
Příklad 4
V databázi hflights zjistěte největší zpoždění za jednotlivé měsíce v roce. Ve skriptu využijte příkaz trubka.
Line charts 2
Column
Hongkong: Liniové grafy 2
Hongkong nás přivádí zpět k balíčku ggplot2, ve kterém si v liniových grafech vyzkoušíme použití trubky, group_by() a summarise(). Na pomoc si též přivoláme databázi Praha_Ostrava, která shromažďuje údaje o železničním spojení mezi Prahou a Ostravou mezi léty 2010 až 2018. S databází Katan v této a následující lekci nebudeme operovat z toho důvodu, jelikož vám chci ukázat práci s časem.
Seznamme se s proměnnými databáze Praha_Ostrava.
# Rok: značí rok platnosti linky v jízdním řádu
# Dopravce: značí konkrétního provozovatele linky (ČD: značí spoje ČD IC/EC/Ex,
# ČD_SC: značí spoje ČD SC Pendolino, RJ: značí RegioJet,
# LE: značí Leo Express)
# Odjezd: značí odjezd vlaku ze zastávky Praha, hl.n.
# Příjezd: značí příjezd vlaku do zastávky Ostrava, hl.n.
# Čas: značí jízdní dobu vlaku
# Frekvence: frekvence označuje jednotlivé dny v týdnu
# (1 = pondělí,..., 7 = neděle), ve kterých je daný spoj vypravován,
# číslo 1234567 můžeme tedy interpretovat tak, že vlak jezdí po celý
# týden bez výjimky (státní svátky byly zanedbány)
# Zastávky: značí celkový počet zastávek vlaku (včetně výchozí a cílové stanice)
# Praha, hl.n. ~ Ostrava, hl.n.: proměnná nabývá hodnoty 1...vlak v dané stanici
# zastavuje a 0...vlak danou stanicí pouze projíždíÚvod máme za sebou, podívejme se na první příklad. V něm nás bude zajímat, kterak vypadal kumulativní vývoj počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018. Vývoj bude zobrazen v procentech a rok 2010 bude hrát roli počátečního období, vůči kterému budeme změny v následujících letech porovnávat.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Data <- Praha_Ostrava %>%
group_by(Rok) %>%
summarise(Součet = sum(Pravidelnost)) %>%
mutate(Kumul = round((Součet/Součet[1]-1), 3))
ggplot(Data,
aes(x = Rok, y = Kumul)) +
geom_line(colour= "#004990", size = 2) +
ggtitle(expression(atop(bold("Kumulativní vývoj počtu spojů"),
atop("mezi léty 2010 až 2018"), ""))) +
theme_economist() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
# axis.title.x definuje grafickou podobu názvu osy x.
# My však vzhledem k příkazu labs(x = "", y = "") název nedefinujeme,
# proto je tento příkaz axis.title.x v zásadě zbytečný, obdobně i
# axis.title.y.
axis.title.y = element_text(color = "black", size = 12),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank())
Na železnici, dějou se věci, na dráze jsou zaměstnáni švarní mládenci. Alespoň tak o tom vypráví píseň s názvem Šel nádražák na mlíčí z pera Járy Cimrmana. Tuto skutečnost potvrzuje i výše uvedený graf, který deklaruje, že se například v roce 2013 zvýšil počet spojů mezi Prahou a Ostravou o více než 80 % v porovnání s rokem 2010. Tento rok je zajímavý zejména z toho důvodu, jelikož v něm na trati Praha-Ostrava začal působit Leoš Novotný a jeho dálkové tramvaje pod značkou Leo Express. Jen pro upřesnění, Radim Jančura s RegioJetem vstoupil na trh již v září roku 2011. Konkurence na železnici proto bezpochyby zapříčinila výrazný nárůst počtu spojů mezi českou a moravskoslezskou metropolí.
Graf našeho prvního příkladu se nesl vcelku v jednoznačném duchu. Co však jeho skript? Je ten dostatečně jasný a srozumitelný? V případě, že nikoliv, jistě uvítáte následující rozbor, ve kterém si vše vysvětlíme. První, co musíme při tvorbě grafu učinit, je nahrát do RStudia veškeré potřebné balíčky. Budeme potřebovat dplyr na práci s data frame a dále ggplot2 a ggthemes na tvorbu samotného grafu.
library(dplyr)
library(ggplot2)
library(ggthemes) Krok číslo dvě je nejdůležitější. Abychom mohli vytvořit graf kumulativního vývoje počtu spojů, musíme k němu vytvořit odpovídající datovou tabulku, která bude tyto hodnoty zobrazovat. Takovouto tabulku přímo v databázi Praha_Ostrava nenalezneme, proto si ji musíme vytvořit.
Nejdříve musí vzniknout nová proměnná, která bude zobrazovat, kolikrát byl daný vlak za týden vypraven. V databázi Praha_Ostrava nalezneme proměnnou s názvem Frekvence, která tyto údaje do jisté míry obsahuje. V případě, že je v ní například uvedeno 12345, znamená to, že daný vlak jel v týdnu pětkrát. Číslo pět je právě tou hodnotou, kterou my potřebujeme přenést do nové proměnné. Jak ale tuto proměnnou stvoříme? K tomu nám poslouží příkaz nchar(), který sčítá počty znaků v daném pozorování (vzpomeňte si na databázi specdata ze čtvrté kapitoly). Číslo 12345 obsahuje pět znaků, proto se výsledkem stane pětka, respektive nová proměnná Pravidelnost, kterou připojíme k databázi Praha_Ostrava.
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Praha_Ostrava[ , c(1, 2, 6, 24)]
# Aby se nám výsledná databáze vešla na obrazovku,
# omezíme výběr pouze na čtyři proměnné.# A tibble: 323 x 4
Rok Dopravce Frekvence Pravidelnost
<dbl> <chr> <dbl> <int>
1 2010 ČD_SC 123457 6
2 2010 ČD_SC 1234567 7
3 2010 ČD_SC 1234567 7
4 2010 ČD_SC 5 1
5 2010 ČD_SC 1234567 7
6 2010 ČD_SC 123457 6
7 2010 ČD_SC 7 1
8 2010 ČD_SC 12345 5
9 2010 ČD_SC 1234567 7
10 2010 ČD 5 1
# ... with 313 more rowsNyní jsme již připraveni vytvořit samotnou datovou tabulku kumulativního vývoje počtu spojů. Nejdříve trubkou pošleme data z databáze Praha_Ostrava do group_by(), který nám je pomyslně rozčlení dle jednotlivých let. Dalším krokem se stane součet hodnot z proměnné Pravidelnost za jednotlivé roky zvlášť (což nám zařídí právě group_by()). Posledním krokem bude výpočet procentuálních změn vůči předchozímu období (roku), jenž uvidíme v nově vytvořené proměnné Kumul v rámci data frame Data (Součet/Součet[1]-1). Jedničku odečítáme z toho důvodu, jelikož chceme na ose y začínat od nuly, a nikoliv od jedné (respektive ze 100 %). Výsledek na závěr ještě zaokrouhlíme na tři desetinná místa.
Data <- Praha_Ostrava %>%
group_by(Rok) %>%
summarise(Součet = sum(Pravidelnost)) %>%
mutate(Kumul = round((Součet/Součet[1]-1), 3))# A tibble: 9 x 3
Rok Součet Kumul
<dbl> <int> <dbl>
1 2010 140 0
2 2011 195 0.393
3 2012 202 0.443
4 2013 259 0.85
5 2014 252 0.8
6 2015 234 0.671
7 2016 245 0.75
8 2017 247 0.764
9 2018 238 0.7 Některým z vás v této chvíli jistě nebude zcela jasný rozdíl mezi příkazy summarise() a mutate(). Struktura obou těchto příkazů totiž vypadá na první pohled velice podobně, jelikož oba tyto příkazy používáme při tvorbě nové proměnné. Příkazy nicméně zaměnitelné nejsou. summarise() totiž vytváří novou proměnnou (chcete-li nový sloupec) data frame a přitom vynechává všechny ostatní proměnné, kterou jsou ve zdrojové databázi přítomny. Jinými slovy, při tvorbě nové proměnné s názvem Součet s pomocí příkazu summarise() vynecháme veškeré proměnné databáze Praha_Ostrava a ponecháme pouze Rok (viz příkaz group_by()) a právě nově vytvořenou proměnnou Součet.
Pokud bychom příkaz summarise() vyměnili za mutate(), získali bychom též proměnnou Součet, ta by se ale stala součástí původní databáze Praha_Ostrava. Výsledná hodnota z proměnné Součet by se ovšem propsala do všech řádků, ve kterých je daný rok uveden. Ostatně podívejte se sami, jak by daný výsledek vypadal. Stačí se zaměřit na hodnotu 140, kterou nyní vidíme u všech vlaků vyjíždějících v roce 2010. Vzhledem k tomu, že jsme použili mutate() místo summarise(), bude mít výsledná databáze Data stejný počet řádků jako ta původní. U summarise() má naopak výsledná databáze takový počet řádků, jako je unikátních kombinací uvnitř group_by().
Data <- Praha_Ostrava %>%
group_by(Rok) %>%
mutate(Součet = sum(Pravidelnost))
Data[ , c(1, 2, 3, 24, 25)]
# Aby se nám výsledná databáze vešla na obrazovku,
# omezíme výběr pouze na pět proměnných.# A tibble: 323 x 5
# Groups: Rok [9]
Rok Dopravce Odjezd Pravidelnost Součet
<dbl> <chr> <dttm> <int> <int>
1 2010 ČD_SC 1899-12-31 11:26:00 6 140
2 2010 ČD_SC 1899-12-31 13:26:00 7 140
3 2010 ČD_SC 1899-12-31 15:26:00 7 140
4 2010 ČD_SC 1899-12-31 16:26:00 1 140
5 2010 ČD_SC 1899-12-31 17:26:00 7 140
6 2010 ČD_SC 1899-12-31 19:26:00 6 140
7 2010 ČD_SC 1899-12-31 20:26:00 1 140
8 2010 ČD_SC 1899-12-31 05:26:00 5 140
9 2010 ČD_SC 1899-12-31 09:26:00 7 140
10 2010 ČD 1899-12-31 13:30:00 1 140
# ... with 313 more rowsPři pohledu na data vás možná zarazí ještě jedna věc a tou je formát času. Proč je zde uveden 31. prosinec roku 1899? Ten je tu z toho důvodu, jelikož data pochází z excelové tabulky a Excel kóduje čas na numerický formát pomocí výchozího data 1. 1. 1990. Při převodu do R se ale toto datum převede na 31. prosinec roku 1899. Tématu času bude věnována pozornost zejména v následující lekci.
Krok číslo tři je nejjednodušší. Spočívá v tvorbě samotného liniového grafu. Vzhledem k tomu, že na y-ové ose chceme vidět procenta, budeme muset využít příkaz scale_y_continuous(labels = scales::percent_format(accuracy = 1)). Výsledné hodnoty na ose budou díky parametru accuracy = 1 bez desetinných míst (accuracy = 0.1 značí jedno desetinné místo, accuracy = 0.01 dvě atd.).
ggplot(Data,
aes(x = Rok, y = Kumul)) +
geom_line(colour = "#004990", size = 2) +
ggtitle(expression(atop(bold("Kumulativní vývoj počtu spojů"),
atop("mezi léty 2010 až 2018"), ""))) +
theme_economist() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust=0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank())
První graf máme za sebou, přesuňme se proto ke grafu č. 2. Ten si klade za cíl zobrazit vývoj počtu zastávek podle jednotlivých dopravců na téže trase mezi Prahou a Ostravou v letech 2010 až 2018.
library(dplyr)
library(ggplot2)
library(ggthemes)
Data <- Praha_Ostrava %>%
group_by(Rok, Dopravce) %>%
summarise_each(funs(median(., na.rm = TRUE)), Zastávky)
ggplot(Data,
aes(x = Rok, y = Zastávky, colour = Dopravce)) +
geom_line(size = 2) +
ggtitle(expression(atop(bold("Vývoj počtu zastávek dopravců"),
atop("mezi léty 2010 až 2018"), ""))) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1)) +
scale_y_continuous(breaks = seq(from = 5, to = 12, by = 1)) +
theme_economist() +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20,
face = "bold", hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
# axis.title.x definuje grafickou podobu názvu osy x.
# My však vzhledem k příkazu labs(x = "", y = "") název nedefinujeme,
# proto je tento příkaz axis.title.x v zásadě zbytečný, obdobně i
# axis.title.y.
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
# axis.text.x definuje grafickou podobu hodnot na ose x,
# zde však pouze zarovnání na střed, které je navíc defaultní,
# proto je tento řádek též v podstatě zbytečný.
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
# fill definuje barvu pozadí v grafu, colour na jeho okraji
legend.title = element_blank()) +
# před legendou nebude uveden název proměnné, tj. proměnné Dopravce
scale_colour_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino",
"Leo Express", "RegioJet"),
values = c("#004990", "#668fcc", "#141414", "#FBBF20"))
# Dopravce rozlišujeme podle parametru colour, proto používáme
# scale_colour_manual() a nikoliv scale_fill_manual() (viz příkaz aes()).
Výše uvedený skript postupuje obdobně jako ten předchozí s několika drobnými úpravami. První rozdíl nalezneme hned v úvodní části skriptu, ve které tvoříme data frame s názvem Data, který zobrazuje počty zastávek pro jednotlivé dopravce v jednotlivých letech. V něm totiž pracujeme s příkazem median(), do kterého musíme uvést zápis median(., na.rm = TRUE), v němž tečka symbolizuje pozici, do které mají data přitéct pomocí trubky z group_by(Rok, Dopravce).
A proč tu vlastně používáme funkci medián? Zastavovací politika dopravců je taková, že drtivá většina linek téhož dopravce a jednoho typu služby (u ČD rozlišujeme dva druhy) zastavuje až na drobné výjimky pokaždé ve stejné stanici. Naším cílem proto je vyřadit ty linky, které se odchylují od drtivé většiny ostatních. Z tohoto důvodu volíme medián, který vyřadí linky s větším či menším počtem zastávek, než je obvyklé.
Data <- Praha_Ostrava %>%
group_by(Rok, Dopravce) %>%
summarise_each(funs(median(., na.rm = TRUE)), Zastávky)# A tibble: 32 x 3
# Groups: Rok [9]
Rok Dopravce Zastávky
<dbl> <chr> <dbl>
1 2010 ČD 10
2 2010 ČD_SC 5
3 2011 ČD 10
4 2011 ČD_SC 5
5 2011 RJ 9
6 2012 ČD 10
7 2012 ČD_SC 5
8 2012 RJ 9
9 2013 ČD 10
10 2013 ČD_SC 5
# ... with 22 more rowsDruhý rozdíl se týká samotného grafu. Jelikož pracujeme s různými dopravci, chceme, aby jednotlivé křivky grafu byly zobrazeny ve firemních barvách daného dopravce. K tomu nám poslouží příkaz scale_colour_manual() či scale_color_manual() (není v nich žádný rozdíl), pomocí kterého nejdříve pojmenujeme jednotlivé křivky v legendě (viz labels) a těm následně přidělíme barvy v hexovém formátu.
scale_colour_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino",
"Leo Express", "RegioJet"),
values = c("#004990", "#668fcc",
"#141414", "#FBBF20"))
# V jakém pořadí označit jednotlivé dopravce? Podle abecedy.
# levels(as.factor(Praha_Ostrava$Dopravce)),
# respektive levels(Praha_Ostrava$Dopravce)
# [1] "ČD" "ČD_SC" "LE" "RJ" A to je z této lekce vše. Tedy skoro vše. V příkladech na vás totiž čekají dva úkoly, které do hloubky prověří vaše nově nabyté znalosti. Pusťte se do nich.
Column
Příklady
Příklad 5
Vytvořte liniový graf kumulativního vývoje počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018 pro veškeré spoje Českých drah. Z tohoto důvodu nezapomeňte, že se jedná nejen o spoje typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce), ale i o spoje ČD SC Pendolino (označení ČD_SC v proměnné Dopravce). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.
Příklad 6
Vytvořte liniový graf mediánu jízdních dob mezi Prahou a Ostravou mezi léty 2010 až 2018 pro jednotlivé dopravce zvlášť. Rozlišujte prosím mezi spoji typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce) a ČD SC Pendolino (označení ČD_SC v proměnné Dopravce). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.
Bar charts 2
Column
Hanoj: Sloupcové grafy 2
Stejně jako u liniových grafů, tak i u těch sloupcových nalezne významné uplatnění balíček dplyr, respektive jeho příkazy trubka, group_by() a summarise(). Podívejme se proto na následující příklad, ve kterém budeme jako v minulé lekci pracovat s databází Praha_Ostrava. Naším úkolem se stane vytvořit sloupcový diagram, který bude zobrazovat počty vlakových spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce. A aby to nebylo tak jednoduché, zobrazíme uprostřed sloupců i samotné číselné hodnoty.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Data <- Praha_Ostrava %>%
group_by(Rok) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost)
ggplot(Data,
aes(x = Rok, y = Pravidelnost)) +
geom_bar(stat = "identity", fill = "#004990") +
# pomocí fill určíme barvu sloupců
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5),
# Pomocí vjust určíme vertikální polohu čísel uvnitř sloupců:
# 0.5 uprostřed, 1 na vrcholu, 0 dole.
# Všimněte si podobnosti s hjust, který používáme pro horizontální
# polohu.
size = 5,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
atop("jedoucích za celý týden bez svátků"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
# pomocí fill definujeme pozadí grafu, pomocí colour jeho okraj
legend.title = element_blank())
Začátek skriptu začínáme nám již známým příkazem nchar(), díky němuž zjistíme u daného řádku (vlaku) počet spojů za jednotlivý týden (ještě před tím nicméně nesmíte zapomenout načíst veškeré potřebné balíčky, pokud je ještě v rámci dané relace načtené nemáte).
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)Krok číslo dvě spočívá ve vytvoření datové tabulky, z níž bude náš sloupcový graf čerpat své údaje. Vzhledem k tomu, že chceme sledovat údaje za jednotlivé roky, využijeme příkaz group_by(), který data rozdělí dle proměnné Rok. Příkaz summarise_each() poté sečte počty spojů za jednotlivá léta a vytvoří proměnnou Pravidelnost v rámci data frame Data.
Data <- Praha_Ostrava %>%
group_by(Rok) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost)
# V příkazu summarise_each() pracujeme s proměnnou Praha_Ostrava$Pravidelnost,
# výsledná proměnná v databázi Data se bude jmenovat též Pravidelnost,
# respektive Data$Pravidelnost.# A tibble: 9 x 2
Rok Pravidelnost
<dbl> <int>
1 2010 140
2 2011 195
3 2012 202
4 2013 259
5 2014 252
6 2015 234
7 2016 245
8 2017 247
9 2018 238Krokem číslo tři se stane tvorba samotného grafu za pomoci příkazu geom_bar(stat = "identity"). Z jakého důvodu tu potřebujeme parametr stat = "identity"? Graf data na osu y přenáší přímo z proměnné Pravidelnost a nic přitom nepočítá. Opakem stat = "identity" je defaultně nastavený parametr stat = "bin", který využíváme například při tvorbě grafů, jež vychází z faktorové proměnné (vzpomeňte si na tvorbu grafů četnosti mužů a žen v Harare).
ggplot(Data,
aes(x = Rok, y = Pravidelnost)) +
geom_bar(stat = "identity", fill = "#004990") +
# pomocí fill určíme barvu sloupců
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5),
# Pomocí vjust určíme polohu čísel uvnitř sloupců: 0.5 uprostřed,
# 1 na vrcholu, 0 dole.
size = 5,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
atop("jedoucích za celý týden bez svátků"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
# pomocí fill definujeme pozadí grafu, pomocí colour jeho okraj
legend.title = element_blank())
Následující úkol bude již o trochu obtížnější, ale doopravdy jen o trochu. Skript bude vycházet z předchozího příkladu pouze s tím rozdílem, že v něm budeme chtít rozlišit dopravní špičku (v čase od 14:00 do 19:00 hodin) od zbytku dne.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Špička <- (ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 15:00:00 UTC" &
Praha_Ostrava$Odjezd <= " 1899-12-31 20:00:00 UTC","
Spoje mezi 14:00 až 19:00", "Ostatní spoje"))
Data <- Praha_Ostrava %>%
group_by(Rok, Špička) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost)
ggplot(Data,
aes(x = Rok, y = Pravidelnost, fill = Špička)) +
geom_bar(stat = "identity") +
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5),
size = 5,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
atop("jedoucích za celý týden bez svátků"), ""))) +
scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme_economist() +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust=0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(labels = c("Dopravní špička od 14:00 - 19:00", "Ostatní spoje"),
values = c("#004990", "#668fcc"))
Abychom úkol mohli vyřešit, museli jsme do předcházejícího skriptu doplnit nový příkaz ifelse(), díky němuž jsme v rámci databáze Praha_Ostrava vytvořili novou proměnnou s názvem Špička. Na příkazu ifelse() není vcelku nic zajímavého až na dva příkazy, které jemu předchází.
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)S časy bývá někdy potíž, proto je dobré, pokud s nimi pracujeme, znovu nastavit jejich datový typ. Z jakého důvodu? Po výše uvedených příkazech pracujeme s příkazem ifelse(), který dělí čas na dvě období: na špičku a mimo ni. Tyto dvě období definujeme přesným časovým vymezením, a právě zde může nastat potíž kvůli časovému posunu. Jinými slovy, čas který vidíte v levém horním panelu po zadání příkazu View(Praha_Ostrava) může R interpretovat jinak a to s určitým, třeba hodinovým či delším posunem. Ostatně vyzkoušejte sami celý předchozí skript našeho druhého příkladu bez uvedení příkazů as.character(), respektive as.POSIXct(). Je totiž velmi pravděpodobné, že následující kód:
Praha_Ostrava$Špička <- (ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00 UTC" &
Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00 UTC",
"Spoje mezi 14:00 až 19:00", "Ostatní spoje"))
Praha_Ostrava[c(2, 10, 18), c(1, 2, 3, 24)]
# Aby se nám vše přehledně vešlo na obrazovku, provedeme
# výběr vybraných řádků a sloupců.# A tibble: 3 x 4
Rok Dopravce Odjezd Špička
<dbl> <chr> <dttm> <chr>
1 2010 ČD_SC 1899-12-31 13:26:00 Spoje mezi 14:00 až 19:00
2 2010 ČD 1899-12-31 13:30:00 Spoje mezi 14:00 až 19:00
3 2010 ČD 1899-12-31 18:11:00 Ostatní spoje bude ve skutečnosti definovat špičku nikoliv jako čas mezi 14:00 - 19:00, ale jako čas mezi 13:00 - 18:00. Abychom se tomuto problému vyhnuli, změnili jsme nejdříve čas na datový typ character a ten následně zpět na čas. V případě, že bychom vynechali příkaz as.character() nedosáhli bychom žádné změny. Z tohoto důvodu, pokud pracujete s časy, vždy si své výsledky kontrolujte a nikdy nespoléhejte ani na zdánlivě správný a bezchybný skript, který žádný error nehlásí.
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Špička <- (ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00 UTC" &
Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00 UTC",
"Spoje mezi 14:00 až 19:00", "Ostatní spoje"))
Praha_Ostrava[c(2, 10, 18), c(1, 2, 3, 24)]# A tibble: 3 x 4
Rok Dopravce Odjezd Špička
<dbl> <chr> <dttm> <chr>
1 2010 ČD_SC 1899-12-31 13:26:00 Ostatní spoje
2 2010 ČD 1899-12-31 13:30:00 Ostatní spoje
3 2010 ČD 1899-12-31 18:11:00 Spoje mezi 14:00 až 19:00Na rozdíl od času, graf neukrývá již žádnou významnou překážku.
ggplot(Data,
aes(x = Rok, y = Pravidelnost, fill = Špička)) +
geom_bar(stat = "identity") +
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5),
size = 5,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu vypravených spojů"),
atop("jedoucích za celý týden bez svátků"), ""))) +
scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme_economist() +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(labels = c("Dopravní špička od 14:00 - 19:00", "Ostatní spoje"),
values = c("#004990", "#668fcc"))
Třetí skript, který si tu v této lekci ukážeme, si klade ještě vyšší cíle. Budeme totiž chtít rozdělit údaje o počtech spojů jedoucích za celý kalendářní týden nejen podle let a odpolední špičky, ale i podle jednotlivých dopravců.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Praha_Ostrava$Špička <- (ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 14:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 19:00:00",
"Spoje mezi 14:00 až 19:00", "Ostatní spoje"))
Data <- Praha_Ostrava %>%
group_by(Rok, Špička, Dopravce) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost)
labels = c(ČD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino", LE = "Leo Express",
RJ = "RegioJet")
ggplot(Data,
aes(x = Rok, y = Pravidelnost, fill = Špička)) +
facet_grid(cols = vars(Dopravce), labeller = labeller(Dopravce = labels)) +
geom_bar(stat = "identity") +
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5),
size = 3,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu spojů podle dopravců"),
atop("mezi léty 2010 až 2018"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 100, by = 10)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 2),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20,
face = "bold", hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(angle = 45, hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(values = c("#004990", "#668fcc"))
Výše uvedený skript byl oproti předchozímu příkladu obohacen o jeden, respektive dva pokyny. Nejdříve bylo nutné vytvořit proměnnou labels s názvy jednotlivých dopravců tak, jak je budeme chtít vidět v samotném grafu.
labels = c(ČD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino",
LE = "Leo Express", RJ = "RegioJet")V následujícím kroku jsme přidali nám už dobře známý příkaz facet_grid(), díky čemuž jsme vytvořili čtyři vedle sebe stojící grafy.
facet_grid(cols = vars(Dopravce), labeller = labeller(Dopravce = labels)) +
# nebo zkráceně
facet_grid(~Dopravce, labeller = labeller(Dopravce = labels))
# V jakém pořadí označit jednotlivé dopravce ve
# výše uvedené proměnné labels? Podle abecedy.
# levels(as.factor(Praha_Ostrava$Dopravce)),
# respektive levels(Praha_Ostrava$Dopravce)
# [1] "ČD" "ČD_SC" "LE" "RJ"
# postup změny pořadí hodnot ve faktoru
# množství <- factor(c("málo", "hodně", "hodně", "málo", "středně"))
# množství
# [1] málo hodně hodně málo středně
# Levels: hodně středně málo
# množství <- factor(množství, levels = c("málo", "středně", "hodně"))
# množství
# [1] málo hodně hodně málo středně
# Levels: málo středně hodně
Poslední čtvrtý příklad bude na rozdíl od těch předcházejících trochu odlišný. Naším cílem totiž bude sestrojit sloupcových graf, jenž bude zobrazovat procentuální podíly jednotlivých dopravců měřenými počtem vypravených vlaků za kalendářní týden.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Data <- Praha_Ostrava %>%
group_by(Rok, Dopravce) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) %>%
group_by(Rok) %>%
mutate(Dohromady = sum(Pravidelnost)) %>%
mutate(Podíl = Pravidelnost/Dohromady)
ggplot(Data,
aes(x = Rok, y = Podíl, fill = Dopravce)) +
geom_bar(stat = "identity") +
geom_text(aes(y = Podíl, label = paste(round(Podíl,2)*100, "%")),
position = position_stack(vjust = 0.5),
size = 4,
hjust = 0.5,
color = "white") +
ggtitle("Procentuální zastoupení vypravených souprav") +
theme_economist() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino",
"Leo Express", "RegioJet"),
values = c("#004990", "#668fcc", "#141414", "#FBBF20"))
Nejobtížnější část tohoto skriptu se ukrývá hned na začátku během tvorby data frame. Projděme si jeho strukturu krok za krokem. Začátek je naprosto standardní jako u předchozích grafů, jelikož spočívá ve vytvoření proměnné Pravidelnost. Následně dojde k sečtení jednotlivých vlakových spojů podle let a dopravců. Výsledek příkazu summarise_each() poté pošleme trubkou do group_by(Rok), který je následován dvěma příkazy mutate(). mutate() zde požíváme místo summarise() proto, jelikož chceme zachovat členění tabulky na roky a dopravce (viz group_by(Rok, Dopravce)). Pokud bychom zvolili summarise(), zůstalo by nám rozdělení pouze na léta (viz příkaz group_by(Rok)). Pomocí prvního příkazu mutate() zjistíme celkový počet vypravených souprav bez ohledu na dopravce v daném roce. Poslední příkaz mutate() nám následně vytvoří proměnnou Podíl, která symbolizuje konečné podíly jednotlivých dopravců na trhu (měřenými počtem vypravených spojů, tj. nikoliv skutečnými tržními podíly).
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Data <- Praha_Ostrava %>%
group_by(Rok, Dopravce) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost) %>%
group_by(Rok) %>%
mutate(Dohromady = sum(Pravidelnost)) %>%
mutate(Podíl = Pravidelnost/Dohromady)# A tibble: 32 x 5
# Groups: Rok [9]
Rok Dopravce Pravidelnost Dohromady Podíl
<dbl> <chr> <int> <int> <dbl>
1 2010 ČD 93 140 0.664
2 2010 ČD_SC 47 140 0.336
3 2011 ČD 85 195 0.436
4 2011 ČD_SC 50 195 0.256
5 2011 RJ 60 195 0.308
6 2012 ČD 84 202 0.416
7 2012 ČD_SC 58 202 0.287
8 2012 RJ 60 202 0.297
9 2013 ČD 84 259 0.324
10 2013 ČD_SC 55 259 0.212
# ... with 22 more rowsV závěru už jen stačí vytvořit standardní sloupcový graf, v němž opět nesmíme zapomenout na geom_bar(stat = "identity"). V případě, že vám ale formát výše zobrazeného grafu nevyhovuje a vy byste raději preferovali, aby jednotlivé sloupce stály vedle sebe a nebyly tudíž poskládány na sebe, využijte příkaz position = "dodge" v rámci příkazu geom_bar() pro samotnou podobu grafu a tentýž příkaz position = "dodge" pro geom_text() (tj. textové popisky v grafu).
ggplot(Data,
aes(x = Rok, y = Podíl, fill = Dopravce)) +
geom_bar(stat = "identity", position = "dodge") +
geom_text(position = position_dodge(0.9),
aes(label = (round(Podíl, 2))*100, y = Podíl),
size = 3,
hjust = 0.5,
vjust = 2,
color = "white") +
ggtitle(expression(
atop(bold("Procentuální zastoupení vypravených souprav"), ""))) +
theme_economist() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust=0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1",
colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino",
"Leo Express", "RegioJet"),
values = c("#004990", "#668fcc", "#141414", "#FBBF20"))
Sedmá kapitola je za námi. S balíčkem tidyverse nicméně stále nekončíme, jelikož jím začneme i poslední osmou kapitolu. V ní se kromě jiného naučíme, jak naše krásné výtvory v R prezentovat světu ve formě graficky atraktivních webových stránek.
Column
Příklady
Příklad 7
Vytvořte sloupcový graf, který bude zobrazovat počty spojů jedoucích veškeré pracovní dny (jeden spoj bude tudíž symbolizovat všech pět spojů v týdnu) bez ohledu na dopravce. Rozdělení proveďte podle jednotlivých let a denní špičky (mezi 14:00 - 19:00). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.
Příklad 8
Vytvořte sloupcový graf, který bude zobrazovat počty všech spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce s rozdělením na ranní spoje (5:00 až 8:59), (do)polední spoje (9:00 až 12:59), odpolední spoje (13:00 až 16:59), večerní spoje (17:00 až 20:59) a noční spoje (21:00 až 4:59). V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.
Příklad 9
K předchozímu příkladu 8 přidejte rozdělení podle jednotlivých dopravců. Oproti předchozímu příkladu však budeme chtít, aby hodnoty na y-ové ose zobrazovaly stejně jako v příkladu 7 pouze počty těch spojů, které jezdí po všechny pracovní dny. V případě potřeby se podívejte na výsledný graf v řešení, který je uveden hned za zadáním, tj. před výsledným skriptem.
Příklady
Column
Column
Příklady: řešení
Příklad 1
S pomocí trubky vytvořte datovou tabulku s názvem Data_z_trubky, která bude obsahovat proměnné Věk, Pohlaví, Vzdělání a Kouření. Názvy těchto proměnných následně přejmenujte na jejich anglické ekvivalenty. V dalších kroku zajistěte, aby v databázi byli zařazeni pouze jedinci ve věku 18 až 26 let (včetně). Na úplný závěr seřaďte hodnoty v proměnných podle věku, pohlaví, vzdělání a kouření v tomto pořadí.
Data_z_trubky <- Katan %>%
select(Věk, Pohlaví, Vzdělání, Kouření) %>%
rename("Age" = Věk, "Gender" = Pohlaví,
"Education" = Vzdělání, "Smoke" = Kouření) %>%
filter(Age >= 18 & Age <= 26) %>%
arrange(Age, Gender, Education, Smoke)# A tibble: 92 x 4
Age Gender Education Smoke
<dbl> <chr> <chr> <chr>
1 18 muž ZŠ nekouří
2 18 muž ZŠ nekouří
3 18 muž ZŠ nekouří
4 18 žena SŠ nekouří
5 18 žena SŠ nekouří
6 18 žena ZŠ kouří
7 18 žena ZŠ nekouří
8 19 muž ZŠ nekouří
9 19 muž ZŠ nekouří
10 19 muž ZŠ nekouří
# ... with 82 more rowsPříklad 2
Zjistěte v následujících věkových skupinách (teenager do 18 let, dospělý od 18 do 26 let, dospělý od 26 do 35 let, dospělý od 35 do 65 let, důchodce 65 let a více) zastoupení mužů a žen a jejich průměrný počet partií na osobu. Ve skriptu využijte příkaz trubka.
Katan2 <- Katan %>%
mutate(VěkSkupiny = cut(Věk,
breaks = c(0, 18, 26, 35, 65, 100),
right = FALSE,
labels = c("teenager do 18 let", "dospělý od 18 do 26 let",
"dospělý od 26 do 35 let", "dospělý od 35 do 65 let",
"důchodce 65 let a více"))) %>%
group_by(Pohlaví, VěkSkupiny) %>%
summarise(Četnost_abs = n(),
Průměr = mean(Partie))# A tibble: 9 x 4
# Groups: Pohlaví [2]
Pohlaví Skupiny Četnost_abs Průměr
<chr> <fct> <int> <dbl>
1 muž teenager do 18 let 16 5.5
2 muž dospělý od 18 do 26 let 47 3.85
3 muž dospělý od 26 do 35 let 43 1.67
4 muž dospělý od 35 do 65 let 32 1.53
5 muž důchodce 65 let a více 4 1.5
6 žena teenager do 18 let 10 4.8
7 žena dospělý od 18 do 26 let 38 3.97
8 žena dospělý od 26 do 35 let 7 2.57
9 žena dospělý od 35 do 65 let 3 2 Příklad 3
Zjistěte průměr, medián a směrodatnou odchylku u proměnných Partie a Věk. Hodnoty určete pro skupiny rozřazené dle proměnných Vzdělání a Pohlaví (tj. ZŠ - muž, ZŠ - žena, SŠ - muž, SŠ - žena atd.). Ve skriptu využijte příkaz trubka.
Katan %>%
group_by(Vzdělání, Pohlaví) %>%
summarise_each(funs(mean, median, sd), Partie, Věk)# A tibble: 8 x 8
# Groups: Vzdělání [4]
Vzdělání Pohlaví Partie_mean Věk_mean Partie_median Věk_median Partie_sd
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Bc - VŠ muž 3.67 23.2 3 23 1.51
2 Bc - VŠ žena 2.69 24.7 3 25 1.11
3 SŠ muž 2.83 30.1 2 25 1.93
4 SŠ žena 4.26 22.7 4 21 2.24
5 VŠ muž 1.63 31.9 1 31 0.859
6 VŠ žena 2.44 27 3 26 1.01
7 ZŠ muž 4.36 27.1 5 17 2.48
8 ZŠ žena 5.23 16 4 16 2.31
# ... with 1 more variable: Věk_sd <dbl>Příklad 4
V databázi hflights zjistěte nejdelší zpoždění za jednotlivé měsíce v roce. Samotný výstup by měl obsahovat pouze proměnné Month, DepDelay a UniqueCarrier, které budou ve výsledné databázi s názvem Zpoždění pojmenovány českými ekvivalenty. Ve skriptu využijte příkaz trubka.
Zpoždění <- flights %>%
group_by(Month) %>%
select(Month, DepDelay, UniqueCarrier) %>%
top_n(1, DepDelay) %>%
rename("Měsíc" = Month, "Zpoždění" = DepDelay, "Přepravce" = UniqueCarrier)# A tibble: 12 x 3
# Groups: Měsíc [12]
Měsíc Zpoždění Přepravce
<int> <int> <chr>
1 1 780 CO
2 2 507 FL
3 3 535 UA
4 4 548 WN
5 5 803 MQ
6 6 869 UA
7 7 420 CO
8 8 981 CO
9 9 588 UA
10 10 730 DL
11 11 931 MQ
12 12 970 AA Příklad 5
Vytvořte liniový graf kumulativního vývoje počtu spojů mezi Prahou a Ostravou mezi léty 2010 až 2018 pro veškeré spoje Českých drah. Z tohoto důvodu nezapomeňte, že se jedná nejen o spoje typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce), ale i o spoje ČD SC Pendolino (označení ČD_SC v proměnné Dopravce).
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Data <- Praha_Ostrava %>%
filter(Dopravce == "ČD" | Dopravce == "ČD_SC" ) %>%
group_by(Rok) %>%
summarise(Součet = sum(Pravidelnost)) %>%
mutate(Kumul = round((Součet/Součet[1]-1),3))
ggplot(Data,
aes(x = Rok, y = Kumul)) +
geom_line(colour = "#004990", size = 2) +
ggtitle(expression(
atop(bold("Kumulativní vývoj spojů Českých drah"),
atop("mezi léty 2010 až 2018"), ""))) +
theme_economist() +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust=0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank())Příklad 6
Vytvořte liniový graf mediánu jízdních dob mezi Prahou a Ostravou mezi léty 2010 až 2018 pro jednotlivé dopravce zvlášť. Rozlišujte prosím mezi spoji typu ČD IC/EC/Ex (označení ČD v proměnné Dopravce) a ČD SC Pendolino (označení ČD_SC v proměnné Dopravce).
library(dplyr)
library(ggplot2)
library(ggthemes)
Data <- Praha_Ostrava %>%
group_by(Rok, Dopravce) %>%
summarise_each(funs(median(., na.rm = TRUE)), Čas)
ggplot(Data,
aes(x = Rok, y = Čas, colour = Dopravce)) +
geom_line(size = 2) +
ggtitle("Vývoj mediánové jízdní doby") +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1)) +
scale_y_datetime(date_breaks = "10 mins", date_labels='%H:%M') +
theme_economist() +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold", hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_color_manual(labels = c("ČD IC/EC/Ex", "ČD SC Pendolino",
"Leo Express", "RegioJet"),
values = c("#004990", "#668fcc", "#141414", "#FBBF20"))Příklad 7
Vytvořte sloupcový graf, který bude zobrazovat počty spojů jedoucích veškeré pracovní dny (jeden spoj bude tudíž symbolizovat všech pět spojů v týdnu) bez ohledu na dopravce. Rozdělení proveďte podle jednotlivých let a denní špičky (mezi 14:00 - 19:00).
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Špička <- (ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 15:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 20:00:00",
"Spoje mezi 14:00 až 19:00", "Ostatní spoje"))
Data <- Praha_Ostrava %>%
filter(Frekvence == 12345 | Frekvence == 1234567 |
Frekvence == 123456 | Frekvence == 123457)
ggplot(Data,
aes(x = Rok, fill = Špička)) +
geom_bar() +
geom_text(stat = "count", position = position_stack(vjust = 0.5),
aes(label = ..count.., y = ..count..),
size = 5,
color = "white") +
ggtitle(expression(
atop(bold("Vývoj počtu vypravených spojů"),
atop("počítáno 1 x za veškeré pracovní dny"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 35, by = 5)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold",
hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(values = c("#004990", "#668fcc")) Příklad 8
Vytvořte sloupcový graf, který bude zobrazovat počty všech spojů jedoucích za celý týden mezi Prahou a Ostravou podle jednotlivých let bez ohledu na dopravce s rozdělením na ranní spoje (5:00 až 8:59), dopolední spoje (9:00 až 12:59), odpolední spoje (13:00 až 16:59), večerní spoje (17:00 až 20:59) a noční spoje (21:00 až 4:59).
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Pravidelnost <- nchar(Praha_Ostrava$Frekvence)
Praha_Ostrava$Doba <-
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 05:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 08:59:59",
"ranní spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 9:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 12:59:59",
"dopolední spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 13:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 16:59:59",
"odpolední spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 17:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 20:59:59",
"večerní spoj","noční spoj"))))
Data5 <- Praha_Ostrava %>%
group_by(Rok, Doba) %>%
summarise_each(funs(sum(., na.rm = TRUE)), Pravidelnost)
ggplot(Data5,
aes(x = Rok, y = Pravidelnost, fill = Doba)) +
geom_bar(stat = 'identity') +
geom_text(aes(y = Pravidelnost, label = Pravidelnost),
position = position_stack(vjust = 0.5), size = 5,
color = "white") +
ggtitle(expression(atop(bold("Vývoj počtu spojů"),
atop("jedoucích za celý týden podle denní doby"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 280, by = 40)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 1),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold", hjust = 0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(
labels = c("Ranní spoj", "Dopolední spoj", "Odpolední spoj",
"Večerní spoj", "Noční spoj"),
values = c("#060b13", "#192e4d", "#2d5086", "#3967ac", "#668fcc"))Příklad 9
K předchozímu příkladu 8 přidejte rozdělení podle jednotlivých dopravců. Oproti předchozímu příkladu však budeme chtít, aby hodnoty na y-ové ose zobrazovaly stejně jako v příkladu 7 pouze počty těch spojů, které jezdí po všechny pracovní dny.
library(dplyr)
library(ggplot2)
library(ggthemes)
Praha_Ostrava$Odjezd <- as.character(Praha_Ostrava$Odjezd)
Praha_Ostrava$Odjezd <- as.POSIXct(Praha_Ostrava$Odjezd)
Praha_Ostrava$Doba <-
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 05:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 08:59:59",
"ranní spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 9:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 12:59:59",
"dopolední spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 13:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 16:59:59",
"odpolední spoj",
ifelse(
Praha_Ostrava$Odjezd >= " 1899-12-31 17:00:00" &
Praha_Ostrava$Odjezd <= " 1899-12-31 20:59:59",
"večerní spoj","noční spoj"))))
Data <- Praha_Ostrava %>%
filter(Frekvence == 12345 | Frekvence == 1234567 |
Frekvence == 123456 | Frekvence == 123457)
labels = c(ČD = "ČD IC/EC/Ex", ČD_SC = "ČD SC Pendolino",
LE = "Leo Express", RJ = "RegioJet")
ggplot(Data,
aes(x = Rok, fill = Doba)) +
facet_grid(~Dopravce, labeller = labeller(Dopravce = labels)) +
geom_bar() +
ggtitle(expression(atop(bold("Vývoj počtu spojů podle dopravců a denní doby"),
atop("počítáno 1 x za veškeré pracovní dny"), ""))) +
theme_economist() +
scale_y_continuous(breaks = seq(from = 0, to = 12, by = 2)) +
scale_x_continuous(breaks = seq(from = 2010, to = 2018, by = 2),
position = "bottom") +
labs(x = "", y = "") +
theme(
plot.title = element_text(color = "black", size = 20, face = "bold", hjust=0.5),
axis.title.x = element_text(color = "black", size = 12),
axis.title.y = element_text(color = "black", size = 12),
axis.text.x = element_text(angle = 45, hjust = 0.5),
plot.background = element_rect(fill = "#DBE5F1", colour = "#DBE5F1"),
legend.title = element_blank()) +
scale_fill_manual(
labels = c("Ranní spoj", "Dopolední spoj", "Odpolední spoj",
"Večerní spoj", "Noční spoj"),
values = c("#060b13", "#192e4d", "#2d5086", "#3967ac", "#668fcc"))